\ This ftest library is inspired by ttester which I read about in
\ https://forth-standard.org/standard/testsuite
\
\ I wrote my own version since my very first compiler is created after reading
\ https://ratfactor.com/forth/the_programming_language_that_writes_itself.html
\ which is not standard. And writing a new library is practically easier and
\ has more fun.
\
\ How does it work?
\ Example: T{ 1 2 3 -> 1 2 3 }T is a successful case
\ It sets up a queue to store the testing values (left hand)
\     1 2 3 ==> Stack (reversed in memory) 3 2 1 ==> Queue 3 2 1
\ Then it compares the expected values from stack with the queue.
\     Stack 3 2 1 vs Queue 3 2 1
\ Note that now the order for the stack and queue are the same.
\
\ The first version was written in and tested with Gforth 0.7.3.

: CELL HERE CELL+ HERE - ;
: >= 2DUP > >R = R> OR ;
: <= 2DUP < >R = R> OR ;

4 CONSTANT queue_len
VARIABLE _queue_head
VARIABLE _queue_tail
CREATE _queue queue_len CELLS ALLOT
: _init_queue
    _queue _queue_head !
    _queue _queue_tail !
;
: _len ( -- n ) _queue_head @ _queue_tail @ - CELL / ;
: _enqueue ( x -- )
    _len queue_len >= ABORT" queue overflow"
    _queue_head @ !
    _queue_head @ 1 CELLS + _queue_head !
;
: _dequeue ( -- x )
    _queue_head @ _queue_tail @ <= ABORT" queue underflow"
    _queue_tail @ @
    _queue_tail @ 1 CELLS + _queue_tail !
;

VARIABLE saved_stack_depth
: _cleanup BEGIN DEPTH saved_stack_depth @ > WHILE DROP REPEAT ;

VARIABLE _fail_count
0 _fail_count !

VARIABLE _test_count
0 _test_count !

: T{
    _test_count @ 1+ _test_count !
    _test_count @
    ." === RUN   " S" Test" 2DUP TYPE _test_count @ . CR
    DEPTH saved_stack_depth !
    _init_queue
;

: ->
    BEGIN DEPTH saved_stack_depth @ > WHILE
        _enqueue
    REPEAT
;

: }T
    DEPTH saved_stack_depth @ -         \ number of expecting values
    _len                                \ number of testing values
    = IF
        _len                            ( yn -- yn n )
        BEGIN
            SWAP _dequeue               ( yn n -- n yn xn )
            2DUP = IF
                2DROP                   ( n yn xn -- n )
            ELSE
                ." incorrect: " . ." vs " . ." at position " DUP . CR
                DROP 1                  \ break iteration
            THEN
        1- DUP 0= UNTIL
    ELSE
        ." mismatched stack" CR
    THEN
    _cleanup
    _len 0= IF
        ." --- PASS: " TYPE . CR        \ print test name saved from stack
    ELSE
        _fail_count @ 1+ _fail_count !
        ." --- FAIL: " TYPE . CR        \ print test name saved from stack
    THEN
;


INCLUDE ftest_test.forth

_fail_count @ 0> [IF] S" FAIL" [ELSE] S" PASS" [THEN] TYPE CR

[THEN] \ End of ftest.forth
